home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / language / xscheme.arc / xscheme.h < prev    next >
C/C++ Source or Header  |  1989-01-29  |  13KB  |  425 lines
  1. /* xscheme.h - xscheme definitions */
  2. /*    Copyright (c) 1988, by David Michael Betz
  3.     All Rights Reserved
  4.     Permission is granted for unrestricted non-commercial use    */
  5.  
  6. /* system specific definitions */
  7. #define UNIX
  8.  
  9. #include <stdio.h>
  10. #include <ctype.h>
  11. #include <setjmp.h>
  12.  
  13. /* FORWARD    type of a forward declaration () */
  14. /* LOCAL    type of a local function (static) */
  15. /* AFMT        printf format for addresses ("%x") */
  16. /* OFFTYPE    number the size of an address (int) */
  17. /* FIXTYPE    data type for fixed point numbers (long) */
  18. /* ITYPE    fixed point input conversion routine type (long atol()) */
  19. /* ICNV        fixed point input conversion routine (atol) */
  20. /* IFMT        printf format for fixed point numbers ("%ld") */
  21. /* FLOTYPE    data type for floating point numbers (float) */
  22. /* FFMT        printf format for floating point numbers (%.15g) */
  23.  
  24. /* for the Lightspeed C compiler - Macintosh */
  25. #ifdef LSC
  26. #define AFMT        "%lx"
  27. #define OFFTYPE        long
  28. #define NIL        (void *)0
  29. #define MACINTOSH
  30. #endif
  31.  
  32. /* for the UNIX System V C compiler */
  33. #ifdef UNIX
  34. #endif
  35.  
  36. /* for the Aztec C compiler - Amiga */
  37. #ifdef AZTEC_AMIGA
  38. #define AFMT        "%lx"
  39. #define OFFTYPE        long
  40. #endif
  41.  
  42. /* for the Mark Williams C compiler - Atari ST */
  43. #ifdef MWC
  44. #define AFMT        "%lx"
  45. #define OFFTYPE        long
  46. #endif
  47.  
  48. /* for the Microsoft C 5.0 compiler */
  49. #ifdef MSC
  50. #define AFMT        "%lx"
  51. #define OFFTYPE        long
  52. #define INSEGMENT(n,s)    (((OFFTYPE)(n) >> 16) == ((OFFTYPE)(s) >> 16))
  53. /* #define MSDOS -- MSC 5.0 defines this automatically */
  54. #endif
  55.  
  56. /* for the Turbo C compiler */
  57. #ifdef _TURBOC_
  58. #define AFMT        "%lx"
  59. #define OFFTYPE        long
  60. #define INSEGMENT(n,s)    (((OFFTYPE)(n) >> 16) == ((OFFTYPE)(s) >> 16))
  61. #define MSDOS
  62. #endif
  63.  
  64. /* size of each type of memory segment */
  65. #ifndef NSSIZE
  66. #define NSSIZE    4000    /* number of nodes per node segment */
  67. #endif
  68. #ifndef VSSIZE
  69. #define VSSIZE    10000    /* number of LVAL's per vector segment */
  70. #endif
  71.  
  72. /* default important definitions */
  73. #ifndef FORWARD
  74. #define FORWARD
  75. #endif
  76. #ifndef LOCAL
  77. #define LOCAL        static
  78. #endif
  79. #ifndef AFMT
  80. #define AFMT        "%x"
  81. #endif
  82. #ifndef OFFTYPE
  83. #define OFFTYPE        int
  84. #endif
  85. #ifndef FIXTYPE
  86. #define FIXTYPE        long
  87. #endif
  88. #ifndef ITYPE
  89. #define ITYPE        long atol()
  90. #endif
  91. #ifndef ICNV
  92. #define ICNV(n)        atol(n)
  93. #endif
  94. #ifndef IFMT
  95. #define IFMT        "%ld"
  96. #endif
  97. #ifndef FLOTYPE
  98. #define FLOTYPE        double
  99. #endif
  100. #ifndef FFMT
  101. #define FFMT        "%.15g"
  102. #endif
  103. #ifndef SFIXMIN
  104. #define SFIXMIN        -1048576
  105. #define SFIXMAX        1048575
  106. #endif
  107. #ifndef CVPTR
  108. #define CVPTR(x)    (x)
  109. #endif
  110. #ifndef INSEGMENT
  111. #define INSEGMENT(n,s)    ((n) >= &(s)->ns_data[0] \
  112.                       && (n) <  &(s)->ns_data[0] + (s)->ns_size)
  113. #endif
  114.  
  115. /* useful definitions */
  116. #define TRUE    1
  117. #define FALSE    0
  118. #ifndef NIL
  119. #define NIL    (LVAL)0
  120. #endif
  121.  
  122. /* program limits */
  123. #define STRMAX        100        /* maximum length of a string constant */
  124. #define HSIZE        199        /* symbol hash table size */
  125. #define SAMPLE        100        /* control character sample rate */
  126.  
  127. /* stack manipulation macros */
  128. #define check(n)    { if (xlsp - (n) < xlstkbase) xlstkover(); }
  129. #define cpush(v)    { if (xlsp > xlstkbase) push(v); else xlstkover(); }
  130. #define push(v)        (*--xlsp = (v))
  131. #define pop()        (*xlsp++)
  132. #define top()        (*xlsp)
  133. #define settop(v)    (*xlsp = (v))
  134. #define drop(n)        (xlsp += (n))
  135.  
  136. /* argument list parsing macros */
  137. #define xlgetarg()    (testarg(nextarg()))
  138. #define xllastarg()    {if (xlargc != 0) xltoomany();}
  139. #define xlpoprest()    {xlsp += xlargc;}
  140. #define testarg(e)    (moreargs() ? (e) : xltoofew())
  141. #define typearg(tp)    (tp(*xlsp) ? nextarg() : xlbadtype(*xlsp))
  142. #define nextarg()    (--xlargc, *xlsp++)
  143. #define moreargs()    (xlargc > 0)
  144.  
  145. /* macros to get arguments of a particular type */
  146. #define xlgacons()    (testarg(typearg(consp)))
  147. #define xlgalist()    (testarg(typearg(listp)))
  148. #define xlgasymbol()    (testarg(typearg(symbolp)))
  149. #define xlgastring()    (testarg(typearg(stringp)))
  150. #define xlgaobject()    (testarg(typearg(objectp)))
  151. #define xlgafixnum()    (testarg(typearg(fixp)))
  152. #define xlganumber()    (testarg(typearg(numberp)))
  153. #define xlgachar()    (testarg(typearg(charp)))
  154. #define xlgavector()    (testarg(typearg(vectorp)))
  155. #define xlgaport()    (testarg(typearg(portp)))
  156. #define xlgaiport()    (testarg(typearg(iportp)))
  157. #define xlgaoport()    (testarg(typearg(oportp)))
  158. #define xlgaclosure()    (testarg(typearg(closurep)))
  159. #define xlgaenv()    (testarg(typearg(envp)))
  160.  
  161. /* node types */
  162. #define FREE        0
  163. #define CONS        1
  164. #define SYMBOL        2
  165. #define FIXNUM        3
  166. #define FLONUM        4
  167. #define STRING        5
  168. #define OBJECT        6
  169. #define PORT        7
  170. #define VECTOR        8
  171. #define CLOSURE        9
  172. #define METHOD        10
  173. #define CODE        11
  174. #define SUBR        12
  175. #define XSUBR        13
  176. #define CSUBR        14
  177. #define CONTINUATION    15
  178. #define CHAR        16
  179. #define PROMISE        17
  180. #define ENV        18
  181.  
  182. /* node flags */
  183. #define MARK        1
  184. #define LEFT        2
  185.  
  186. /* port flags */
  187. #define PF_INPUT    1
  188. #define PF_OUTPUT    2
  189. #define PF_BINARY    4
  190.  
  191. /* new node access macros */
  192. #define ntype(x)    ((OFFTYPE)(x) & 1 ? FIXNUM : (x)->n_type)
  193.  
  194. /* macro to determine if a non-nil value is a pointer */
  195. #define ispointer(x)    (((OFFTYPE)(x) & 1) == 0)
  196.  
  197. /* type predicates */                   
  198. #define atom(x)        ((x) == NIL || ntype(x) != CONS)
  199. #define null(x)        ((x) == NIL)
  200. #define listp(x)    ((x) == NIL || ntype(x) == CONS)
  201. #define numberp(x)    ((x) && ntype(x) == FIXNUM || ntype(x) == FLONUM)
  202. #define boundp(x)    (getvalue(x) != s_unbound)
  203. #define iportp(x)    (portp(x) && (getpflags(x) & PF_INPUT) != 0)
  204. #define oportp(x)    (portp(x) && (getpflags(x) & PF_OUTPUT) != 0)
  205.  
  206. /* basic type predicates */                   
  207. #define consp(x)    ((x) && ntype(x) == CONS)
  208. #define stringp(x)    ((x) && ntype(x) == STRING)
  209. #define symbolp(x)    ((x) && ntype(x) == SYMBOL)
  210. #define portp(x)    ((x) && ntype(x) == PORT)
  211. #define objectp(x)    ((x) && ntype(x) == OBJECT)
  212. #define fixp(x)        ((x) && ntype(x) == FIXNUM)
  213. #define floatp(x)    ((x) && ntype(x) == FLONUM)
  214. #define vectorp(x)    ((x) && ntype(x) == VECTOR)
  215. #define closurep(x)    ((x) && ntype(x) == CLOSURE)
  216. #define codep(x)    ((x) && ntype(x) == CODE)
  217. #define methodp(x)    ((x) && ntype(x) == METHOD)
  218. #define subrp(x)    ((x) && ntype(x) == SUBR)
  219. #define xsubrp(x)    ((x) && ntype(x) == XSUBR)
  220. #define charp(x)    ((x) && ntype(x) == CHAR)
  221. #define promisep(x)    ((x) && ntype(x) == PROMISE)
  222. #define envp(x)        ((x) && ntype(x) == ENV)
  223. #define booleanp(x)    ((x) == NIL || ntype(x) == BOOLEAN)
  224.  
  225. /* cons access macros */
  226. #define car(x)        ((x)->n_car)
  227. #define cdr(x)        ((x)->n_cdr)
  228. #define rplaca(x,y)    ((x)->n_car = (y))
  229. #define rplacd(x,y)    ((x)->n_cdr = (y))
  230.  
  231. /* symbol access macros */
  232. #define getvalue(x)     ((x)->n_vdata[0])
  233. #define setvalue(x,v)     ((x)->n_vdata[0] = (v))
  234. #define getpname(x)     ((x)->n_vdata[1])
  235. #define setpname(x,v)     ((x)->n_vdata[1] = (v))
  236. #define getplist(x)     ((x)->n_vdata[2])
  237. #define setplist(x,v)     ((x)->n_vdata[2] = (v))
  238. #define SYMSIZE        3
  239.  
  240. /* vector access macros */
  241. #define getsize(x)    ((x)->n_vsize)
  242. #define getelement(x,i)    ((x)->n_vdata[i])
  243. #define setelement(x,i,v) ((x)->n_vdata[i] = (v))
  244.  
  245. /* object access macros */
  246. #define getclass(x)    ((x)->n_vdata[0])
  247. #define setclass(x,v)    ((x)->n_vdata[0] = (v))
  248. #define getivar(x,i)    ((x)->n_vdata[i])
  249. #define setivar(x,i,v)    ((x)->n_vdata[i] = (v))
  250.  
  251. /* promise access macros */
  252. #define getpproc(x)    ((x)->n_car)
  253. #define setpproc(x,v)    ((x)->n_car = (v))
  254. #define getpvalue(x)    ((x)->n_cdr)
  255. #define setpvalue(x,v)    ((x)->n_cdr = (v))
  256.  
  257. /* closure access macros */
  258. #define getcode(x)    ((x)->n_car)
  259. #define getenv(x)    ((x)->n_cdr)
  260.  
  261. /* code access macros */
  262. #define getbcode(x)        ((x)->n_vdata[0])
  263. #define setbcode(x,v)        ((x)->n_vdata[0] = (v))
  264. #define getcname(x)        ((x)->n_vdata[1])
  265. #define setcname(x,v)        ((x)->n_vdata[1] = (v))
  266. #define getvnames(x)        ((x)->n_vdata[2])
  267. #define setvnames(x,v)        ((x)->n_vdata[2] = (v))
  268. #define FIRSTLIT        3
  269.  
  270. /* fixnum/flonum/character access macros */
  271. #define getfixnum(x)    ((OFFTYPE)(x) & 1 ? getsfixnum(x) : (x)->n_int)
  272. #define getflonum(x)    ((x)->n_flonum)
  273. #define getchcode(x)    ((x)->n_chcode)
  274.  
  275. /* small fixnum access macros */
  276. #define cvsfixnum(x)    ((LVAL)(((OFFTYPE)x << 1) | 1))
  277. #define getsfixnum(x)    ((FIXTYPE)((OFFTYPE)(x) >> 1))
  278.  
  279. /* string access macros */
  280. #define getstring(x)    ((unsigned char *)(x)->n_vdata)
  281. #define getslength(x)    ((x)->n_vsize)
  282.  
  283. /* iport/oport access macros */
  284. #define getfile(x)    ((x)->n_fp)
  285. #define setfile(x,v)    ((x)->n_fp = (v))
  286. #define getsavech(x)    ((x)->n_savech)
  287. #define setsavech(x,v)    ((x)->n_savech = (v))
  288. #define get